home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Ham Radio
/
Ham Radio CD-ROM (Emerald Software) (1995).ISO
/
maps
/
gr8circl
/
gr8circl.bas
Wrap
BASIC Source File
|
1991-09-26
|
7KB
|
226 lines
40 CLS
50 PRINT "GREAT CIRCLE BEARINGS AND DISTANCES PROGRAM"
52 REM
55 PRINT
60 PRINT "DO YOU NEED INSTRUCTIONS? YES OR NO"
65 INPUT I$
70 IF I$ = "NO" THEN 165
100 PRINT "THIS PROGRAM CALCULATES GREAT CIRCLE DISTANCES IN"
110 PRINT "STATUTE MILES AND KILOMETERS AND BEARINGS BETWEEN"
120 PRINT "YOU AND THE REST OF THE WORLD. LATITUDES IN THE"
130 PRINT "NORTHERN MEM ARE POSITIVE AND SOUTHERN HEM ARE NEG."
140 PRINT "LONGITUDES IN THE EASTERN HEM ARE POSITIVE"
150 PRINT "AND WESTERN HEM ARE NEGATIVE. ALWAYS USE DEGREES"
160 PRINT "WITH DECIMAL PARTS - NO MINUTES AND SECONDS"
165 PRINT
170 PRINT "WHAT IS YOUR NAME AND CALL LETTER?"
175 LINE INPUT N$
180 PRINT "WHAT IS YOUR LOCATION (HOME QTH)?"
185 LINE INPUT W$
190 PRINT "WHAT IS THE LATITUDE OF THIS LOCATION?"
195 INPUT A
200 REM CONVERT A TO RADIANS
205 LET A1=A*3.1415926#/180
210 PRINT
220 PRINT "WHAT IS THE LONGITUDE OF THIS LOCATION?"
240 INPUT L1
250 LET J=0
252 LET F=0
255 GOSUB 2000
260 PRINT "SELECT THE FUNCTION YOU WANT AND ENTER THE NUMBER"
265 PRINT
270 PRINT "1 = GLOBAL GRID CENTERED ON YOUR LOCATION"
275 PRINT " (LAT EVERY 15 DEGREES & LONG EVERY 30 DEGREES"
280 PRINT "2 = BEARINGS AND DISTANCES TO MAJOR US CITIES"
285 PRINT "3 = BEARINGS & DISTANCE TO DX LOCATIONS FROM THE"
290 PRINT " ARRL COUNTRIES LIST - LISTED BY CALL PREFIX"
292 PRINT "4 = BOTH US CITIES AND DX LIST."
295 PRINT "5 = BEARINGS & DISTANCE TO USER SELECTED POINTS"
300 PRINT "6 = ENTER NEW CENTRAL LOCATION"
305 PRINT "7 = TERMINATE THE PROGRAM***"
307 PRINT
310 INPUT S
312 PRINT
315 ON S GOTO 400,515,605,510,700,50,9999
400 GOSUB 2000
401 PRINT "GREAT CIRCLE COORDINATES CENTERED ON";W$
405 PRINT
410 PRINT "PROGRAMMED FOR ";N$
430 PRINT
435 PRINT "LATITUDE LONGITUDE MILES KILOMETERS BEARING"
437 PRINT "-------------------------------------------"
440 FOR L2 = -180 TO 180 STEP 30
450 FOR B = - 90 TO 90 STEP 30
460 GOSUB 1000
465 PRINT TAB3;B;TAB11;L2;TAB22;D1;TAB30;D2;TAB44;R2
468 REM CHECK THE LINE COUNTER
469 LET K = K+1
470 IF K=55 THEN 485
475 NEXT B
480 NEXT L2
482 GOTO 250
485 GOSUB 2000
490 PRINT "LATITUDE LONGITUDE MILES KILOMETERS BEARING"
491 PRINT "-------------------------------------------"
495 GOTO 475
500 REM 500 NUMBERED STATEMENTS READ THE FIRST SET OF DATA
502 REM WHICH CONTAINS THE US CITIES DATA AND PRINTS LIST
508 REM F IS A FLAG TO SEE IF BOTH CITIES & DX LIST ARE
509 REM DESIRED. IF YES ENTER AT 510 & F=1
510 LET F=1
514 REM 515 IS ENTRY POINT FOR CITIES ONLY (F=0 PRESET)
515 GOSUB 2000
520 PRINT "CITIES LISTING CENTERED ON";W$;" FOR ";N$
525 PRINT
530 PRINT "BEARINGS AND DISTANCES TO MAJOR US CITIES"
535 PRINT
540 PRINT TAB5;"CITY";TAB15;"LAT/LONG MILES K/M BEARING"
545 PRINT"-------------------------------------------------"
550 LET K=K+1
559 REM READ DATA & CHECK FOR END OF FILE.
560 READ M$,B,L2
565 IF M$="ENDATA1" THEN 597
569 REM GO PERFORM THE CALCULATIONS
570 GOSUB 1000
575 PRINT M$;TAB13;B;"/";L2;TAB28;D1;TAB35;D2;TAB43;R2
580 IF K=55 THEN 590
585 GOTO 550
590 GOSUB 2000
595 GOTO 540
596 REM IS FLAG SET FOR BOTH CITIES AND DX LIST?
597 IF F=1 THEN 614
598 RESTORE
599 GOTO 250
600 REM 600 NUMBERED STATEMENTS READ THE SECOND SET OF
602 REM DATA WHICH IS THE DX COUNTRIES LIST DATA.
603 REM 605 TO 610 FIND THE END OF THE FIRST DATA.
605 READ M$,B,L2
608 IF M$ = "ENDATA1" THEN 614
610 GOTO 605
614 GOSUB 2000
615 PRINT "BEARINGS TO DX LOCATIONS ON ARRL COUNTRIES LIST"
620 PRINT "DEL - MEANS A COUNTRY DELETED FROM ARRL LIST"
625 PRINT
630 PRINT "DX LISTING CENTERED FROM ";W$;" FOR ";N$
635 PRINT
640 PRINT TAB5;"DX PREFIC LAT/LONG MILES K/M BEARING"
645 PRINT "----------------------------------------------"
650 LET K=K+1
655 LET J=J+1
660 READ M$,B,L2
665 IF M$="ENDATA2" THEN 696
670 GOSUB 1000
675 PRINT J;TAB5;M$;TAB15;B;"/";L2;TAB29;D1;TAB36;D2;TAB45;R2
680 IF K=55 THEN 690
685 GOTO 650
690 GOSUB 2000
695 GOTO 640
696 RESTORE
699 GOTO 250
700 REM THE 700 NUMBERED STATEMENTS MAKE UP THE ROUTINE TO
701 REM CALCULATE USER ENTERED COORDINATES ONE AT A TIME.
705 PRINT "ENTER DISTANT LOCATION DESIGNATION"
715 LINE INPUT M1$
720 PRINT
725 PRINT "ENTER LATITUDE OF DISTANT POINT."
735 INPUT B
740 PRINT
745 PRINT "ENTER LONGITUDE OF DISTANT POINT."
755 INPUT L2
760 GOSUB 1000
765 PRINT
770 PRINT "DISTANCE FROM ";W$;" TO ";M1$;" IS ";D1;" MILES."
771 PRINT "THAT DISTANCE IS ";D2;" KILOMETERS."
772 PRINT "BEARING TO ";M1$;" IS ";R2; "DEGREES."
775 PRINT
780 PRINT "DO YOU WANT OTHER POINTS CALCULATED? YES OR NO"
785 PRINT
790 INPUT T$
795 IF T$ = "YES" THEN 705
799 GOTO 250
1000 REM 1000 SERIES SUBROUTINE PERFORMS ALL CALCULATIONS.
1001 LET L=L2-L1
1002 REM - X IS A FLAG FOR TESTING L
1003 LET X=0
1005 REM BRING L WITHIN RANGE -180 TO 180
1010 IF L<-180 GOTO 1025
1015 IF L>180 GOTO 1035
1020 GOTO 1040
1025 LET L=L+360
1030 GOTO 1100
1035 LET L=L-360
1040 IF L<0 THEN 1100
1045 LET X=1
1100 REM CONVERT LAND B TO RADIANS
1110 LET B1=B*3.1415926#/180
1115 LET L=L*3.1415926#/180
1119 REM COMPUTE THE DISTANCE ANGLE
1120 LET P=COS(L)*COS(A1)*COS(B1)+SIN(A1)*SIN(B1)
1125 LET P1=ATN(SQR(1-P*P)/P)
1130 LET P2=P1*180/3.1415926#
1134 REM DISTANCE ANGLE MUST BE POSITIVE IF NOT ADD 180
1135 IF P2<0 GOTO 1145
1140 GOTO 1150
1145 LET P2=P2+180
1149 REM COMPUTE DISTANCE
1150 LET D1 = INT(P2*60*1.15152+.5)
1151 LET D2 = INT(D1*1.6093+.5)
1154 REM COMPUTE THE BEARING ANGLE.
1155 LET R=COS(B1)*SIN(L)/SIN(P1)
1160 LET R1=ATN(R/SQR(1-R*R))
1164 REM CONVERT BEARINGS TO DEGREES ROUNDED TO NEAREST INT
1165 LET R2=INT((R1*180/3.1415926#)+.5)
1168 REM DETERMINE WHAT QUADRANT THE BEARING ANGLE IS IN AND
1169 REM ADJUST THE DEGREES.
1170 IF ABS(R)>.999998 THEN 1500
1175 IF ABS(R)<.00174 THEN 1600
1180 LET B2=(B+.1)*3.1415926#/180
1185 LET R3=COS(L)*COS(A1)*COS(B2)+SIN(B2)*SIN(A1)
1190 LET R4=ATN(SQR(1-R3*R3)/R3)
1200 LET R6=COS(B2)*SIN(L)/SIN(R4)
1205 IF X=1 THEN 1240
1210 IF ABS(R6) >ABS(R) THEN 1230
1215 LET R2=360-ABS(R2)
1220 GOTO 1700
1230 LET R2=180+ABS(R2)
1235 GOTO 1700
1240 IF ABS(R6) < ABS(R) THEN 1255
1245 LET R2 = 180-ABS(R2)
1250 GOTO 1700
1255 LET R2 = ABS(R2)
1260 GOTO 1700
1500 IF X=1 THEN 1530
1510 LET R2=270
1520 GOTO 1700
1530 LET R2=90
1540 GOTO 1700
1600 IF ABS(L)>178 THEN 1640
1605 IF B<A THEN 1630
1610 LET R2=0
1620 GOTO 1700
1630 LET R2=180
1635 GOTO 1700
1640 IF B>A THEN 1630
1645 GOTO 1610
1700 RETURN
2000 REM THIS ROUTINE PRINTS BLANK LINES AFTER EVERY 55
2001 REM LINES OF DATA SO PAPER CAN BE CUT STANDARD SIZED.
2005 PRINT
2006 PRINT
2007 PRINT
2008 PRINT
2009 PRINT
2010 PRINT
2011 PRINT
2012 PRINT
2020 K=0
2030 RETURN
-α/ 1 3@5`7Ç9á;└=α? A C@E`GÇIáK└MαO Q S@U`WÇYá[└]α_ a c@e`gÇiák└mαo q s@u`wÇyá{└}α ü â@à`çÇëáï└ìαÅ æ ô@ ò` ùÇ Öá ¢└ ¥α ƒ
í
ú@
Ñ`
ºÇ
⌐á
½└
¡α
»≡ ▒ │@╡`╖Ç╣á╗└╜α┐ ┴ ├@┼`╟Ç╔á╦└═α╧ ╤ ╙@╒`╫Ç┘á█└▌α▀ ß π@σ`τÇΘáδ└φα∩ ± ≤≡ ⌡`≈Ç∙á√└²α !Aaü í┴ß!Aaüí┴ß /#A%a'ü)í+┴-ß/1!3A5a7ü9í;┴=ß?A± CAEaGüIíK┴MßOQ!SAUa